home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Games Collection 1 / software vault.zip / software vault / CDR10 / SPX20.ZIP / SPX_DEMO.ZIP / DEMO05.PAS < prev    next >
Pascal/Delphi Source File  |  1993-09-24  |  4KB  |  167 lines
  1. Program Demo5;
  2.  
  3. { SPX library - Palette demo Copyright 1993 Scott D. Ramsay  }
  4.  
  5. Uses crt,spx_vga,spx_key,spx_img,spx_tim;
  6.  
  7. const
  8.   path = '';
  9.  
  10. var
  11.   pal     : array[0..1] of RGBlist;
  12.   col     : RGBtype;
  13.   next    : byte;
  14.   oldexit : pointer;
  15.  
  16. procedure stall(seconds:integer);
  17. begin
  18.   s_clk[0] := seconds*18;
  19.   repeat
  20.     if esc
  21.       then halt;
  22.   until s_clk[0]=0;
  23. end;
  24.  
  25.  
  26. procedure cleanup;far;
  27. var
  28.   temp : rgblist;
  29. begin
  30.   fgetcolors(temp);
  31.   fadeout(20,temp);
  32.   closemode;
  33.   exitproc := oldexit;
  34. end;
  35.  
  36.  
  37. procedure setup;
  38. begin
  39.   setrate(2000);
  40.   openmode(3);
  41.   oldexit := exitproc; exitproc := @cleanup;
  42.   fsetcolors(zdc);   { all black palette }
  43.   setpageactive(3);
  44.   loadpcx(path+'fire.pcx');
  45.   pal[1] := rgb256;
  46.   setpageactive(2);
  47.   loadpcx(path+'tank.pcx');
  48.   pal[0] := rgb256;
  49.   next := 2;
  50. end;
  51.  
  52.  
  53. function sequence(b:integer):integer;
  54. var
  55.   temp : RGBlist;
  56.   c    : integer;
  57. begin
  58.   sequence := 0;
  59.   case b of
  60.     0 : begin
  61.           pcopy(next,1);
  62.           fadein(60,pal[next-2]);
  63.           sequence := 2;
  64.         end;
  65.     1 : begin
  66.           col.red := 63; col.green := 63; col.blue := 63;
  67.           temp := pal[next-2];
  68.           colorschange(temp,col);
  69.           fsetcolors(temp);
  70.           sequence := 1;
  71.         end;
  72.     2 : begin
  73.           col.red := 63; col.green := 0; col.blue := 0;
  74.           temp := pal[next-2];
  75.           colorschange(temp,col);
  76.           fsetcolors(temp);
  77.           sequence := 1;
  78.         end;
  79.     3 : begin
  80.           col.red := 0; col.green := 63; col.blue := 0;
  81.           temp := pal[next-2];
  82.           colorschange(temp,col);
  83.           fsetcolors(temp);
  84.           sequence := 1;
  85.         end;
  86.     4 : begin
  87.           col.red := 0; col.green := 0; col.blue := 63;
  88.           temp := pal[next-2];
  89.           colorschange(temp,col);
  90.           fsetcolors(temp);
  91.           sequence := 1;
  92.         end;
  93.     5 : begin
  94.           col.red := 63; col.green := 40; col.blue := 10;
  95.           temp := pal[next-2];
  96.           colorschange(temp,col);
  97.           fsetcolors(temp);
  98.           sequence := 1;
  99.         end;
  100.     6 : begin
  101.           fsetcolors(pal[next-2]);
  102.           sequence := 2;
  103.         end;
  104.     7 : begin
  105.           temp := pal[next-2];
  106.           for c := 0 to 255 do
  107.             begin
  108.               if esc
  109.                 then halt;
  110.               ColorCycle(temp,0,256,true);
  111.               fsetcolors(temp);
  112.               f_clk[0] := 10; repeat until f_clk[0]=0;
  113.             end;
  114.         end;
  115.     8 : begin
  116.           temp := pal[next-2];
  117.           fsetcolors(temp);
  118.           stall(2);
  119.           for c := 0 to 500 do
  120.             begin
  121.               if esc
  122.                 then halt;
  123.               ColorCycle(temp,192,63,false);
  124.               fsetcolors(temp);
  125.               f_clk[0] := 10; repeat until f_clk[0]=0;
  126.             end;
  127.           sequence := 2;
  128.         end;
  129.     9 : fadeout(30,pal[next-2]);
  130.   end;
  131. end;
  132.  
  133.  
  134. procedure Animate;
  135. var
  136.   step : integer;
  137. begin
  138.   step := 0;
  139.   repeat
  140.     stall(sequence(step));
  141.     step := (step+1)mod 10;
  142.     if step=0
  143.       then next := 5-next;
  144.   until esc;
  145. end;
  146.  
  147.  
  148. procedure showit;
  149. begin
  150.   clrscr;
  151.   writeln('SPX library - Palette demo');
  152.   writeln('Copyright 1993 Scott D. Ramsay');
  153.   writeln;
  154.   writeln('Keys:');
  155.   writeln(' ESC          - quit demo');
  156.   writeln;
  157.   write('Press SPACE to continue.');
  158.   clearbuffer;
  159.   repeat until space;
  160. end;
  161.  
  162.  
  163. begin
  164.   showit;
  165.   setup;
  166.   Animate;
  167. end.